home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue39 / Clinic / LockInfU.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-08-24  |  2.0 KB  |  81 lines
  1. unit LockInfU;
  2.  
  3. interface
  4.  
  5. uses
  6.   WinProcs, WinTypes, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  7.   Dialogs, StdCtrls, Grids, DBGrids, Db, DBTables, ExtCtrls, DBCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     ListBox1: TListBox;
  12.     Table1: TTable;
  13.     DataSource1: TDataSource;
  14.     DBGrid1: TDBGrid;
  15.     Button1: TButton;
  16.     DBNavigator1: TDBNavigator;
  17.     procedure Button1Click(Sender: TObject);
  18.     procedure Table1AfterPost(DataSet: TDataSet);
  19.     procedure FormCreate(Sender: TObject);
  20.   private
  21.     { Private declarations }
  22.   public
  23.     { Public declarations }
  24.   end;
  25.  
  26. var
  27.   Form1: TForm1;
  28.  
  29. implementation
  30.  
  31. {$R *.DFM}
  32.  
  33. uses
  34.   DbiProcs, DbiTypes, DbiErrs;
  35.  
  36. procedure GetLockList(Tbl: TTable; LockList: TStrings);
  37. const
  38.   Locks: array[0..9] of String = ('normal record write lock (write)',
  39.     'special Paradox record lock (read)',
  40.     'Paradox group lock', 'Paradox image lock',
  41.     'non-lock (table open & registered)', 'table read lock',
  42.     'table write lock', 'table exclusive lock',
  43.     'bogus (unknown) lock', 'unknown lock');
  44. var
  45.   TmpCursor: HDbiCur;
  46.   Lock: LOCKDesc;
  47.   Res: DbiResult;
  48. begin
  49.   Check(DbiOpenLockList(Tbl.Handle, True, True, TmpCursor));
  50.   Check(DbiSetToBegin(TmpCursor));
  51.   LockList.Clear;
  52.   repeat
  53.     Res:= DbiGetNextRecord(TmpCursor, dbiNoLock, @Lock, nil);
  54.     if (Res <> DbiErr_Eof) then
  55.       with Lock do
  56.         LockList.Add(Format(
  57.           '%s has a %s on %s (record %d, session %d, net session %d)',
  58.           [szUserName, Locks[iType], Tbl.TableName, iRecNum, iSession, iNetSession]));
  59.   until (Res <> DbiErr_None);
  60.   Check(DbiCloseCursor(TmpCursor));
  61. end;
  62.  
  63. procedure TForm1.Button1Click(Sender: TObject);
  64. begin
  65.   GetLockList(Table1, ListBox1.Items)
  66. end;
  67.  
  68. procedure TForm1.Table1AfterPost(DataSet: TDataSet);
  69. begin
  70.   DbiSaveChanges((DataSet as TTable).Handle)
  71. end;
  72.  
  73. procedure TForm1.FormCreate(Sender: TObject);
  74. begin
  75. {$ifdef Win32}
  76.   DBNavigator1.Flat := True
  77. {$endif}
  78. end;
  79.  
  80. end.
  81.